;;;;;;;;;;;;;;;;;;;;;;;
; CL-ZEROCONF browser ;
;;;;;;;;;;;;;;;;;;;;;;;

(defvar *cl-zeroconf-browser*)
;(defvar *browser-process*)

(defclass cl-zeroconf-browser (remote-object) ())

(defmethod dns-sd:browse-add-service (cl-zeroconf-browser service interface-index more-coming-p)
  (declare (ignore more-coming-p))
  ;(debug-print "service discovered" (dns-sd:service-type service))
  (dns-sd:resolve service cl-zeroconf-browser))

(defmethod dns-sd:browse-resolved-service (cl-zeroconf-browser service)
  ;(debug-print "service resolved" (dns-sd:service-type service))
  (send *discovery-actor* (service-resolved *discovery-actor* service) nil))

(defmethod dns-sd:browse-remove-service (cl-zeroconf-browser service interface-index more-coming-p)
  (declare (ignore more-coming-p))
  ;(debug-print "service removed" (dns-sd:service-type service))
  (send *discovery-actor* (service-removed *discovery-actor* service) nil))

(defmethod dns-sd:browse-error (discoverer error)
  (format t "~&The following error occurred while browsing: ~s~%" error))

(defun start-network ()
  (setf *cl-zeroconf-browser* (dns-sd:browse "_p2pchat._tcp" "" (make-instance 'cl-zeroconf-browser)))
  (start-services)
  (mp:process-run-function
                           "discovery-event-processor"
                           '()
                           #'(lambda ()
                               (loop
                                (unless (boundp '*cl-zeroconf-browser*) (return))
                                (sleep 2)
                                (dns-sd:process-dns-sd-events 2.0)))))

(defun stop-network ()
  (stop-services)
  (sleep 5)
  (dns-sd:cancel *cl-zeroconf-browser*)
  (makunbound '*cl-zeroconf-browser*))

(defun start-services ()
  (dolist (service-cons (discoverer-published-services *discovery-actor*))
    (dns-sd:publish (cdr service-cons) nil)))

(defun stop-services ()
  (dolist (service-cons (discoverer-published-services *discovery-actor*))
    (dns-sd:cancel (cdr service-cons))))

;;;;;;;;;;;;;;;;;;;;;;;
; DISCOVERY BEHAVIOUR ;
;;;;;;;;;;;;;;;;;;;;;;;
(defclass discoverer (remote-object)
  ((required-services :initform nil :accessor discoverer-required-services)
   (imported-services :initform nil :accessor discoverer-imported-services)
   (published-services :initform nil :accessor discoverer-published-services)))

(defmethod publish-service-with-description (discoverer remote-object service-description)
  (let ((service (make-instance 'dns-sd:service
                                 :name (remote-object-name remote-object)
                                 :type service-description
                                 :host *device-address*
                                 :port *device-port*
                                 :txt-record (dns-sd:build-txt-record 
                                              (list (cons "object-name" (remote-object-name remote-object))
                                                    (cons "actor-name" (remote-object-name (remote-object-actor
                                                                                            remote-object))))))))
    ;(debug-print "exported service" (dns-sd:service-type service))
    (push (cons service-description service) (discoverer-published-services discoverer))
    (dns-sd:publish service nil)))
    ;(send *discovery-event-processor* (process-events *discovery-event-processor*))))

(defmethod cancel-service-with-description (discoverer remote-object service-description)
  (let ((service))
    (setf (discoverer-published-services discoverer)
          (remove-if #'(lambda (remote-object-cons)
                         (let ((remote-reference (convert-service-into-remote-reference discoverer (cdr remote-object-cons))))
                           (setf service (cdr remote-object-cons))
                           (and (equal service-description (car remote-object-cons))
                                (equal (remote-reference-object-name remote-reference) (remote-object-name remote-object)))))
                     (discoverer-published-services discoverer)))
    (when service
      ;(debug-print "service removed" service)
      (dns-sd:cancel service))))
    ;(debug-print "service already removed" service)))

    ;(send *discovery-event-processor* (process-events *discovery-event-processor*))))
 
(defmethod import-service-with-description (discoverer service-description cardinality)
  ;(when-resolved (send *discovery-event-processor* (process-events *discovery-event-processor*))
                 ;(lambda (useless-result)
  (let ((remote-reference))
    (dolist (service-cons (discoverer-imported-services discoverer))
      (when (equal service-description (car service-cons))
        (setf remote-reference (cdr service-cons))
        ;(debug-print "service previously imported matched" service-description)
        (send *communication-actor* (service-connected *communication-actor*
                                                       service-description remote-reference))))
    (if (not remote-reference)
        (push (cons service-description cardinality) (discoverer-required-services discoverer))
      (when (equal cardinality :any)
        (push (cons service-description cardinality) (discoverer-required-services discoverer))))))

(defmethod convert-service-into-remote-reference (discoverer service)
  (let* ((record (dns-sd:parse-txt-record (dns-sd:service-txt-record service)))
         (remote-reference (make-instance 'remote-reference
                                          :address (dns-sd:service-host service)
                                          :port (dns-sd:service-port service)
                                          ; tricky, I know
                                          :object-name (dns-sd::bytes-to-string (cdar record))
                                          :actor-name (dns-sd::bytes-to-string (cdadr record)))))
    remote-reference))

(defmethod imported-servicep (discoverer service-description remote-reference)
  (find-if #'(lambda (description-cons)
                 (and (equal service-description (car description-cons))
                      (reference-equal remote-reference (cdr description-cons))))
           (discoverer-imported-services discoverer)))

(defmethod find-imported-services (discoverer service-description)
  (find-if #'(lambda (description-cons)
               (equal service-description (car description-cons)))
           (discoverer-imported-services discoverer)))

(defmethod remove-imported-service (discoverer service-description remote-reference)
  (setf (discoverer-imported-services discoverer) (remove service-description (discoverer-imported-services discoverer)
                                                          :test #'equal :key #'car)))

(defmethod required-servicep (discoverer service-description)
  (find-if #'(lambda (description-cons)
                 (equal service-description (car description-cons)))
           (discoverer-required-services discoverer)))

(defmethod add-required-service-if-applicable (discoverer service-description)
  (unless (required-servicep discoverer service-description)
    (push (cons service-description :one) (discoverer-required-services discoverer))))

(defmethod remove-required-service-if-applicable (discoverer service-description)
  (setf (discoverer-required-services discoverer) (remove-if #'(lambda (description-cons)
                                                                 (and (equal service-description (car description-cons))
                                                                      (not (equal (cdr description-cons) :any))))
                                                             (discoverer-required-services discoverer))))
;;;;;;;;;;;;;;;;;;;;;;;;;
;   Correspondence to   ;
; CL-ZEROCONF callbacks ;
;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod service-resolved (discoverer service)
  (let ((remote-reference (convert-service-into-remote-reference discoverer service)))
    ;(debug-print "service resolved" (dns-sd:service-type service))
    (unless (imported-servicep discoverer (dns-sd:service-type service) remote-reference)
      (push (cons (dns-sd:service-type service) remote-reference) (discoverer-imported-services discoverer)))
    (when (required-servicep discoverer (dns-sd:service-type service))
      ;(debug-print "service previously required matched" (dns-sd:service-type service))
      (send *communication-actor* (service-connected *communication-actor* (dns-sd:service-type service) remote-reference))
      (remove-required-service-if-applicable discoverer (dns-sd:service-type service)))))

(defmethod service-removed (discoverer service)
  (let ((remote-reference (convert-service-into-remote-reference discoverer service)))
    (when (imported-servicep discoverer (dns-sd:service-type service) remote-reference)
      (send *communication-actor* (service-disconnected *communication-actor* remote-reference))
      (remove-imported-service discoverer (dns-sd:service-type service) remote-reference)
      (add-required-service-if-applicable discoverer (dns-sd:service-type service)))))

;;;;;;;;;;;;;;;;;;;;;;;
; DISCOVERY FUNCTIONS ;
;;;;;;;;;;;;;;;;;;;;;;;
; IMPORT-SERVICE
(defun import-service (service-description)
  (let ((channel (make-instance 'channel :service-description service-description)))
    (when-resolved (send *communication-actor* (add-channel *communication-actor* channel))
                   (lambda (useless-result)
                     (send *discovery-actor* (import-service-with-description *discovery-actor* service-description :one))))
    channel))

(defun when-discovered (channel continuation-lambda)
  (let ((discovery-future (make-instance 'future)))
    (when-resolved discovery-future continuation-lambda)
    (send channel (add-discovery-observer channel discovery-future))))

(defun when-disconnected (channel continuation-lambda)
  (let ((disconnection-future (make-instance 'future)))
    (when-resolved disconnection-future continuation-lambda)
    (send channel (add-disconnection-observer channel disconnection-future))))

(defun when-reconnected (channel continuation-lambda)
  (let ((reconnection-future (make-instance 'future)))
    (when-resolved reconnection-future continuation-lambda)
    (send channel (add-reconnection-observer channel reconnection-future))))

(defun whenever-discovered (service-description continuation-lambda)
  (let ((multiple-discovery-future (make-instance 'future)))
    (when-resolved multiple-discovery-future
                   (lambda (channel)
                     (when-discovered channel continuation-lambda)))
    (send *communication-actor* (add-any-discovery-observer *communication-actor*
                                                                           multiple-discovery-future
                                                                           service-description))
    (send *discovery-actor* (import-service-with-description *discovery-actor* service-description :any))))

; PUBLISH-SERVICE
(defun publish-service (object service-description)
  (send *discovery-actor* (publish-service-with-description *discovery-actor* object service-description)))

; CANCEL SERVICE
(defun cancel-service (object service-description)
  (send *discovery-actor* (cancel-service-with-description *discovery-actor* object service-description)))

; INITIALISE *discovery-actor*
(setf *discovery-actor* (make-instance 'discoverer))
(make-actor "discovery" *discovery-actor*)
